Well over twenty years a go I first entered the world of Basic programming when I bought a kit of parts to build the Spectrum ZX81 computer, produced by a guy called Clive Sinclair. Needless to say I failed to solder all the tiny components in correctly, which used a Z80 CPU, and the kit had to go back to the suppliers for repair. The ZX81 in the UK was a revolution in home PCs in its time, but had several drawbacks due to its low cost, such as the fragile membrane keyboard, and few survive today because of deterioration in the thin ribbon cable.
As a result a host of small firms sprung up offering improvements, such as a nice solid click key keyboard. Another enterprising firm offered an extra board which I bought, holding two 16Kb chips storing some 250 additional graphic CHR$s plus 16Kb extra RAM, which enabled extra graphics to be designed on a 8 x 8 pixels matrix. This was when I first developed a simple program to design simple graphics. LB allows us far greater control over Graphic Design, and the creation of Sprites, but even the old BBC computer and Qbasic had functions for creating Sprites.
The following can be used to create graphics up to 150 x 100 pixels limited by the 800 X 600 mode used. Providing the background is filled in black, you can then use the nice mask creation program that comes with LB to create a Sprite, and is attached to my program below. Gordon Sweet
' User Design Graphics
nomainwin
ux = 1 : uy = 1
if DisplayWidth > 1000 then ux = 120 : uy = 90
[start]
UpperLeftX = ux : UpperLeftY = uy
WindowWidth = 800 : WindowHeight = 580
button #1, "Plot ", [plot], UL, 640, 200
button #1, "Move ", [move], UL, 720, 200
button #1, "Erase", [eras], UL, 640, 240
button #1, "Fill ", [fill], UL, 720, 240
button #1, "Save ", [save], UL, 640, 280
button #1, "Load ", [load], UL, 720, 280
button #1, "Color", [colr], UL, 640, 320
button #1, "Quit ", [quit], UL, 720, 320
button #1, "N", [n], UL, 700, 420
button #1, "W", [w], UL, 670, 450
button #1, "E", [e], UL, 730, 450
button #1, "S", [s], UL, 700, 480
tl$="Start near Top Left, and Save/Scan only the section you need. "
tg$ = "UDG BMP file Generator. " + tl$
open tg$ for graphics_nsb as #1
[redraw]
#1 "trapclose [quit]; font fixedsys; down"
#1 "place 100 200; size 2"
#1 "\Maximum size of image is 150 x 100"
#1 "\\Use N S E W buttons to navigate position."
#1 "\To CLEAR, select Background color, and"
#1 "\then FILL. If intending to create a "
#1 "\Sprite Image, then Fill a Black background."
#1 "\\You can create a Sprite after SAVE file."
#1 "place 660 145" : #1 "\Actual Image"
#1 "place 670 530" : #1 "\NAVIGATION"
#1 "place 50 540" : #1 "\";tl$
for xruler = 630 to 780 step 10 ' for sample box
#1 "set ";xruler;" 18"
next xruler
for yruler = 20 to 120 step 10
#1 "set 628 ";yruler
next yruler
#1 "size 1; place 628 18; box 782 122" ' sample box
#1 "place 7 8; box 610 508" ' main box
#1 "color black; place 730 390; circlefilled 10"
#1 "place 650 395" : #1 "\Color = "
bg$ = "255 255 255" : temp$ = bg$ : pix$ = bg$
plot = 2 : mode$ = "PLOT" ' default option
col$ = "black" : temp$ = col$ ' default color
px = 10 : x2 = px : py = 12 : y2 = py ' main box
sx = 630 : sy = 20 ' sample box
h = hwnd(#1) : win1 = 1 : goto [current]
[loop]
gosub [test]
#1 "backcolor white; color black ; place 630 12"
#1 "\";" " : #1 "place 630 12"
#1 "\X Y Points ";str$(sx-629);" ";str$(sy-19)
#1 "place 660 180" : #1 "\Mode = ";mode$
cur$ = "255 0 0"
if pix$="255 0 0" then cur$="255 255 255"
#1 "size 2; color ";cur$
#1 "set ";px;" ";py
wait
[move]
#1 "color ";pix$ : #1 "size 4; set ";px;" ";py
plot = 1 : mode$ = "MOVE "
goto [loop]
[plot]
plot = 2 : mode$ = "PLOT "
goto [loop]
[eras]
plot = 3 : mode$ = "ERASE"
goto [loop]
[colr]
colordialog "white", col$
if col$="" then notice "Nothing Delected!" : goto [colr]
[current]
#1 "size 1; color black; backcolor ";col$
#1 "place 730 390; circlefilled 10"
goto [loop]
[n]
if py < 13 then [loop]
gosub [reset] : y2=py : py=py-5 : sy=sy-1 : goto [loop]
[s]
if py > 504 then [loop]
gosub [reset] : y2=py : py=py+5 : sy=sy+1 : goto [loop]
[e]
if px > 604 then [loop]
gosub [reset] : x2=px : px=px+4 : sx=sx+1 : goto [loop]
[w]
if px < 11 then [loop]
gosub [reset] : x2=px : px=px-4 : sx=sx-1 : goto [loop]
[reset]
select case plot
case 1 : temp$ = pix$
case 2 : temp$ = col$
case 3 : temp$ = bg$
end select
#1 "color ";temp$ : #1 "size 4; set ";px;" ";py
#1 "size 1; set ";sx;" ";sy
return
[fill]
confirm "OK to clear the Work Space?"; cl$
if cl$="no" then [loop]
bg$ = col$
#1 "size 1; color black; backcolor ";bg$
#1 "place 7 8; boxfilled 610 508"
#1 "place 628 18; boxfilled 782 122"
goto [loop]
[test]
' find pixel color at px & py
calldll#user32,"GetDC", h as word, hdc as word
calldll #gdi32,"GetPixel",_
hdc as ulong,_
px as ulong,_
py as ulong,_
pixcol as ulong
CallDll #user32, "ReleaseDC",_
hw as word,_
hdc as word,_
result as ushort
b = int(pixcol / (256*256))
g = int((pixcol - b *256*256) / 256)
r = int(pixcol - b*256*256 - g*256)
pix$=str$(r)+" "+str$(g)+" "+str$(b)
return
[save]
if box=1 then close #b
#1 "flush"
gosub [size]
[sfile]
filedialog "BMP Image to Save","*.bmp",SFile$
if SFile$ = "" then [loop]
#1 "getbmp drawing 630 20 ";xmax;" ";ymax
bmpsave "drawing", SFile$
#1 "redraw"
confirm "Create a Sprite?";sprite$
if sprite$ = "yes" then gosub [mask]
goto [loop]
[abort] box = 0 : close #b : goto [loop]
[load]
confirm "OK to overwrite?"; ov$
if ov$ = "no" then [loop]
#1 "flush"
filedialog "BMP Image to Test","*.bmp",LFile$
if LFile$="" then [loop]
#1 "redraw; size 1; color black; backcolor ";bg$
#1 "place 7 8; boxfilled 610 508"
#1 "place 628 18; boxfilled 782 122"
loadbmp "temp", LFile$
#1 "drawbmp temp 630 20"
gosub [size]
xbox = 10 : ybox = 13
#1 "size 4" ' scan image and plot main box
for py = 20 to 20 + ymax
for px = 630 to 629 + xmax
gosub [test]
#1 "color ";pix$
#1 "set ";xbox;" ";ybox
xbox = xbox + 4
next px
xbox = 10 : ybox = ybox + 4.9
next py
pix$ = col$ : px = 10 : py = 11
goto [loop]
[size]
UpperLeftX = 300+ux : UpperLeftY = 300+uy
WindowWidth = 160: WindowHeight = 120
statictext #b "Enter Size", 10, 24, 40, 30
statictext #b, "Width", 60, 10, 40, 20
statictext #b, "Length", 100, 10, 40, 20
textbox #b.tbox1, 58, 30, 30, 25
textbox #b.tbox2, 100, 30, 30, 25
button #b.default, "Accept", [pass], UL, 70, 60, 42, 25
open "Max. of Box" for dialog as #b
#b "trapclose [npass]"
#b.tbox1 10
#b.tbox2 10
#b.tbox1, "!setfocus"
[npass]
mainH=hWnd(#b) : gosub [boxhold]
box = 1 : xmax = 0 : ymax = 0
wait
[pass]
print #b.tbox1, "!contents? A$" : xmax=val(A$)
print #b.tbox2, "!contents? B$" : ymax=val(B$)
if xmax<2 or xmax>150 or ymax<2 or ymax>100 then
notice "INVALID Entry!";xmax;" ";ymax
goto [npass]
end if
box = 0 : close #b : return
[mask]
close #1 : win1 = 0
'small utility to add masks to the top of sprite
' images for use in LB3 as supplied with LB
bmpheight=0 'bitmap height
bmpwidth=0 'bitmap width
bitmap$="" 'bitmap file name
savefile$="" 'save file name
hBitmap=0 'handle for loaded bitmap
hWindow=0 'window handle
dx = 1 : dy = 1
if DisplayWidth > 1000 then dx = 100 : dy = 100
UpperLeftX = dx : UpperLeftY = dy
WindowWidth = 800 : WindowHeight = 600
menu #s, "&File", "&Open Sprite",[openSprite],_
"&Save As...",[saveAs],|,"E&xit",[quit]
open "Add Masks to Sprites" for graphics_nsb as #s
#s "trapclose [quit]"
#s "down; font arial 36 bold; place 200 100"
#s "|Sprite Generator" : #s "font ariel 14 bold"
#s "|Open the desired sprite image - File / Open Sprite"
#s "|A mask will be added to the sprite as you watch."
#s "|This might take time for large images."
#s "|Images larger than the window will be cut off."
#s "|If it is satisfactory, choose 'File / Save As"
hWindow=hwnd(#s)
[loop2]
input aVar$
[openSprite]
if hBitmap<>0 then
unloadbmp ("bm")
#s "cls"
end if
filedialog "Open Sprite","*.bmp",bitmap$
if bitmap$="" then
notice "No bitmap chosen!"
goto [loop2]
end if
#s "cls"
loadbmp "bm" , bitmap$
hBitmap=hbmp("bm")
#s "down;drawbmp bm 0 0"
bmpheight=HeightBitmap(bitmap$)
bmpwidth=WidthBitmap(bitmap$)
#s "drawbmp bm 0 ";bmpheight
call MakeMask bmpwidth, bmpheight, hWindow
goto [loop2]
[saveAs]
#s "getbmp SpriteMask 0 0 ";bmpwidth;" ";2*bmpheight
filedialog "Save As... ","*.bmp",savefile$
if savefile$="" then
notice "No filename specified!"
goto [loop2]
end if
bmpsave "SpriteMask",savefile$
notice "Sprite and mask saved as ";savefile$
goto [loop2]
'************FUNCTIONS******************
function WidthBitmap(name$)
open name$ for input as #pic
pic$=input$(#pic,29)
close #pic
WidthBitmap = asc(mid$(pic$,19,1)) + _
(asc(mid$(pic$,20,1)) * 256)
end function
function HeightBitmap(name$)
open name$ for input as #pic
pic$=input$(#pic,29)
close #pic
HeightBitmap = asc(mid$(pic$,23,1)) + _
(asc(mid$(pic$,24,1)) * 256)
end function
sub MakeMask wide, high, hWnd
cursor hourglass
white=(255*256*256)+(255*256)+255
black=0
open "user32" for dll as #user
Open "gdi32"for DLL as #gdi
CallDll #user, "GetDC",_
hWnd as long,_
hDC as long
for i = 0 to wide-1
for j = 0 to high-1
CallDll #gdi, "GetPixel",_
hDC as long,_
i as long,_
j as long,_
pColor as long
if pColor=black then
newColor=white
else
newColor=black
end if
CallDll #gdi, "SetPixel",_
hDC as long,_
i as long, _
j as long, _
newColor as long, _
r as long
next j
next i
CallDll #user, "ReleaseDC",_
hWnd as long,_
hDC as long,_
r as long
close #user
close #gdi
cursor normal
end sub
[quit]
if box = 1 then close #b
if win1 = 0 then close #s
if win1 = 1 then close #1
confirm "Image Saved, OK to Quit?"; q$
if q$ = "no" then [start]
end
[boxhold]
open "user32" for dll as #user ' prevents losing box
toTop=(-1 or 0)
flags=_SWP_NOMOVE or _SWP_NOSIZE
calldll #user,"SetWindowPos",mainH as ushort,toTop as short,_
0 as short,0 as short,0 as short,0 as short,flags as ushort,_
result as void
close #user : return